Option Explicit
Sub F_Sample038()
   'Microsoft ActiveX Data Objects 2.X Library ]wޥζ
   'Microsoft ADO Ext. 2.1 for DDL and Security ]wޥζ
   'ոF_Data.mdb
    Dim myCon     As New ADODB.Connection
    Dim myCat     As New ADOX.Catalog
    Dim myCmd     As ADODB.Command
    Dim myView    As ADOX.View
    Dim myProc    As ADOX.Procedure
    Dim myPrm     As ADODB.Parameter
    Dim i As Long
    Dim j As Long
    Dim myFileName As String
    myFileName = "F_Data.mdb"				'wɮצW
    myCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & ThisWorkbook.Path & "\" & myFileName & ";"
    Set myCat.ActiveConnection = myCon
    Worksheets.Add						'u@sW
    'wgX
    Columns(3).ColumnWidth = 90
    Cells(1, 1).Resize(, 4).Value = _
        Array("QRY_NAME", "PRM_NAME", "SQL/TYP", "DIR")
    i = 2
   'VIEW
    For Each myView In myCat.Views
        With myView
        Set myCmd = .Command
            Cells(i, 1).Resize(, 3).Value = _
                Array(.Name, myCmd.CommandType, myCmd.CommandText)
        End With
        i = i + 1
        j = 1
        For Each myPrm In myCmd.Parameters
            With myPrm
                Cells(i, 1).Resize(, 4).Value = _
                Array(j, .Name, GetConstStr_ADO(.Type), .Direction)
                '`ഫ
            End With
            i = i + 1: j = j + 1
        Next myPrm
        i = i + 1
    Next myView
   'Procedures
    For Each myProc In myCat.Procedures
        With myProc
        Set myCmd = .Command
            Cells(i, 1).Resize(, 3).Value = _
                Array(.Name, myCmd.CommandType, myCmd.CommandText)
        End With
        i = i + 1
        j = 1
        For Each myPrm In myCmd.Parameters
            With myPrm
                Cells(i, 1).Resize(, 4).Value = _
                Array(j, .Name, GetConstStr_ADO(.Type), .Direction)
                '`ഫ
            End With
            i = i + 1: j = j + 1
        Next myPrm
        i = i + 1
    Next myProc
    myCon.Close
    Set myPrm = Nothing					'
    Set myView = Nothing
    Set myProc = Nothing
    Set myCmd = Nothing
    Set myCon = Nothing
    Set myCat = Nothing
End Sub
Function GetConstStr_ADO(myInt As Integer) As String
    Dim myStr As String
    Select Case myInt
        Case 20: myStr = "adBigInt"
        Case 128: myStr = "adBinary"
        Case 11: myStr = "adBoolean"
        Case 8: myStr = "adBSTR"
        Case 136: myStr = "adChapter"
        Case 129: myStr = "adChar"
        Case 6: myStr = "adCurrency"
        Case 7: myStr = "adDate"
        Case 133: myStr = "adDBDate"
        Case 134: myStr = "adDBTime"
        Case 135: myStr = "adDBTimeStamp"
        Case 14: myStr = "adDecimal"
        Case 5: myStr = "adDouble"
        Case 0: myStr = "adEmpty"
        Case 10: myStr = "adError"
        Case 64: myStr = "adFileTime"
        Case 72: myStr = "adGUID"
        Case 9: myStr = "adIDispatch"
        Case 3: myStr = "adInteger"
        Case 13: myStr = "adIUnknown"
        Case 205: myStr = "adLongVarBinary"
        Case 201: myStr = "adLongVarChar"
        Case 203: myStr = "adLongVarWChar"
        Case 131: myStr = "adNumeric"
        Case 138: myStr = "adPropVariant"
        Case 4: myStr = "adSingle"
        Case 2: myStr = "adSmallInt"
        Case 16: myStr = "adTinyInt"
        Case 21: myStr = "adUnsignedBigInt"
        Case 19: myStr = "adUnsignedInt"
        Case 18: myStr = "adUnsignedSmallInt"
        Case 17: myStr = "adUnsignedTinyInt"
        Case 132: myStr = "adUserDefined"
        Case 204: myStr = "adVarBinary"
        Case 200: myStr = "adVarChar"
        Case 12: myStr = "adVariant"
        Case 139: myStr = "adVarNumeric"
        Case 202: myStr = "adVarWChar"
        Case 130: myStr = "adWChar"
        Case Else: myStr = "Error"
    End Select
    GetConstStr_ADO = myStr
End Function
